home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / smaltalk / stv.lha / STV / ISA / carolina / tictacto.prj < prev    next >
Text File  |  1993-07-23  |  12KB  |  479 lines
  1. "
  2. ******************************************************************************
  3. Project : TicTacToe
  4. Date    : Oct 10, 1989
  5. Time    : 21:43:42
  6.  
  7. Introduction
  8. ============
  9.  
  10. "Interactive TicTacToe game
  11. based on W. LaLonde & J. Pugh
  12. J.O.O.P Sept/Oct 1989 pp 57-66"
  13.  
  14.  
  15.  
  16. Invoked By:
  17. ===========
  18.  
  19. InteractiveTicTacToe example1
  20.  
  21.  
  22.  
  23. Description
  24. ===========
  25.  
  26. Classes : 
  27.     TileDispatcher TilePane TicTacToeGame 
  28.     InteractiveTicTacToe 
  29.  
  30. Methods : 
  31.  
  32. ******************************************************************************
  33. "!
  34.  
  35. "Initialize"
  36.  
  37. InteractiveTioTacToe example1
  38. !
  39.  
  40. Dispatcher subclass: #TileDispatcher
  41.   instanceVariableNames: ''
  42.   classVariableNames: ''
  43.   poolDictionaries: 
  44.     'FunctionKeys CharacterConstants '!
  45.  
  46. SubPane subclass: #TilePane
  47.   instanceVariableNames: 
  48.     'tiles selectedTile enterTileSelector exitTileSelector selectTileSelector '
  49.   classVariableNames: ''
  50.   poolDictionaries: ''!
  51.  
  52. Object subclass: #TicTacToeGame
  53.   instanceVariableNames: 
  54.     'winningLines board lastPlayer winner winningLine '
  55.   classVariableNames: ''
  56.   poolDictionaries: ''!
  57.  
  58. TicTacToeGame subclass: #InteractiveTicTacToe
  59.   instanceVariableNames: 
  60.     'gameRectangle tiles '
  61.   classVariableNames: ''
  62.   poolDictionaries: ''!
  63.  
  64.  
  65. !TileDispatcher class methods ! !
  66.  
  67.  
  68. !TileDispatcher methods !
  69.  
  70. isControlActive
  71. "Answer true if mouse is over the pane or
  72. the mouse is down"
  73. ^super isControlActive or:
  74.     [Terminal mouseSelectOn]!
  75.  
  76. processFunctionKey: aCharacter
  77. "Process function characters"
  78. aCharacter == SelectFunction
  79.     ifTrue: [^pane mouseDown].
  80. aCharacter == EndSelectFunction
  81.     ifTrue: [pane mouseUp.
  82.     ^Terminal initialize
  83.     "clear all characters"].
  84. aCharacter == SetLoc
  85.     ifTrue: [^Terminal mouseSelectOn
  86.         ifTrue: [pane mouseMove]].
  87. aCharacter == ScrollUpFunction
  88.     ifTrue: [^super processFunctionKey: PaneMenuRequest].
  89. aCharacter == ScrollDownFunction
  90.     ifTrue: [^nil].
  91. super processFunctionKey: aCharacter
  92.     "otherwise beep"!
  93.  
  94. processMouseEvent: aCharacter
  95. "process mouse characters"
  96. self processFunctionKey: aCharacter! !
  97.  
  98.  
  99. !TilePane class methods !
  100.  
  101. example1
  102. " TilePane example1 "
  103. super new initialize! !
  104.  
  105.  
  106. !TilePane methods !
  107.  
  108. activeTile
  109. "Return the tile containing the cursor or nil"
  110. ^tiles
  111.     detect: [:aTile | (frame scaleTo: aTile)
  112.             containsPoint: Cursor offset]
  113.     ifNone: [nil]!
  114.  
  115. defaultDispatcherClass
  116. "Answer the default dispatcher class TileDispatcher"
  117. ^TileDispatcher!
  118.  
  119. enterTile
  120. "Tell model the mouse has entered the tile
  121. default to reversing the tile"
  122. (model respondsTo: enterTileSelector)
  123.     ifTrue: [model perform: enterTileSelector
  124.                     with: selectedTile]
  125.     ifFalse: [self reverseTile].!
  126.  
  127. exitTile
  128. "Tell model the mouse has exited the tile
  129. default to reversing the tile"
  130. (model respondsTo: exitTileSelector)
  131.     ifTrue: [model perform: exitTileSelector
  132.                     with: selectedTile]
  133.     ifFalse: [self reverseTile].!
  134.  
  135. initialize
  136. "Initialize the pane"
  137. super initialize.
  138. curFont := SysFont!
  139.  
  140. mouseDown
  141. "mouse down in the pane @ cursor
  142. enter selected tile if any"
  143. (selectedTile := self activeTile) isNil
  144.         ifFalse: [self enterTile].!
  145.  
  146. mouseMove
  147. "everytime the mouse moves, notify the model
  148. if boundary is crossed or significant event occurs"
  149.  | newTile |
  150. (newTile := self activeTile) == selectedTile
  151.                             ifTrue: [^self].
  152. selectedTile isNil ifFalse: [self exitTile].
  153. (selectedTile := newTile) isNil ifFalse: [self enterTile].!
  154.  
  155. mouseUp
  156. "mouse button released at the pane @ cursor
  157.  inform model"
  158. (selectedTile := self activeTile) isNil
  159.         ifFalse: [self exitTile;
  160.                   selectTile.
  161.                   selectedTile := nil].!
  162.  
  163. onMouseEnteringTile: aSymbol
  164. enterTileSelector := aSymbol!
  165.  
  166. onMouseExitingTile: aSymbol
  167. exitTileSelector := aSymbol!
  168.  
  169. onMouseSelectingTile: aSymbol
  170. selectTileSelector := aSymbol!
  171.  
  172. reverseTile
  173. "reverse color of tile"
  174.  | tileArea |
  175. tileArea := frame scaleTo: selectedTile.
  176. tileArea := tileArea origin truncated corner:
  177.             tileArea corner truncated.
  178. Display gray: (tileArea intersect: frame)!
  179.  
  180. selectTile
  181. "Tell model the mouse has selected the tile"
  182. (model respondsTo: selectTileSelector)
  183.     ifTrue: [model perform: selectTileSelector
  184.                     with: selectedTile].!
  185.  
  186. showWindow
  187. "Display the pane and get update from model"
  188. self border.
  189. tiles := model perform: name with: frame!
  190.  
  191. update
  192. "get latest data from model"
  193. self showWindow! !
  194.  
  195.  
  196. !TicTacToeGame class methods !
  197.  
  198. example1
  199. " TicTacToeGame example1 "
  200. "Play game directly without dispatcher or pane"
  201. | aGame firstPlayer response |
  202. aGame := TicTacToeGame new.
  203. firstPlayer := (self yesNoPrompt: 'Does the X player wish to start?')
  204.     ifTrue: [#X]
  205.     ifFalse: [#O].
  206. aGame nextPlayer: firstPlayer.
  207. (aGame gameOver) whileFalse:[
  208.     response := Prompter
  209.                 prompt:'Player ', aGame nextPlayer,
  210.                 'please provide the next board coordinate' "as a point"
  211.                 defaultExpresion: '1@1'.
  212. (aGame isLegalFor: (aGame nextPlayer) toPlayAt: response)
  213.     ifTrue: [aGame play: (aGame nextPlayer) at: response]
  214.     ifFalse: [(self yesNoPrompt: 'Bad move, do you want to continue?')
  215.         ifFalse: [^self]]].
  216. Menu message: (aGame winner == #NoOne
  217.     ifTrue: ['A tie']
  218.     ifFalse: ['Player', aGame winner , 'wins'])!
  219.  
  220. example2
  221. | aGame |
  222.     aGame := TicTacToeGame new.
  223. WinningLines inspect!
  224.  
  225. new
  226. ^super new initialize!
  227.  
  228. yesNoPrompt: queryString
  229. ^((Menu
  230.     labels: queryString, '\yes\no' withCrs
  231.     lines: #(1)
  232.     selectors: #(no yes no))
  233.   popUpAt: Cursor offset) == #yes! !
  234.  
  235.  
  236. !TicTacToeGame methods !
  237.  
  238. at: aCoordinate
  239. | xval yval val|
  240. xval := aCoordinate x.
  241. yval := aCoordinate y.
  242. val := 3*(xval - 1) + yval.
  243. ^board at: val.!
  244.  
  245. at: aCoordinate put: aValue
  246. ^board at: 3*((aCoordinate x) - 1)
  247.             +(aCoordinate y)
  248.        put: aValue!
  249.  
  250. gameOver
  251. "Returns true if game is over"
  252. self winner == #NoOne
  253.     ifFalse: [^true].
  254. board do: [:square | square == #Empty
  255.                 ifTrue: [^false]].
  256. ^true!
  257.  
  258. initialize
  259. "Generate all possible winning triples"
  260. | square1 square2 square3 |
  261. winningLines :=
  262.     #((0 1 2) (3 4 5) (6 7 8) "rows"
  263.       (0 3 6) (1 4 7) (2 5 8) "columns"
  264.       (0 4 8) (2 4 6) "diagonals")
  265.       collect: [:triple |
  266.             square1 := triple first.
  267.             square2 := triple at: 2.
  268.             square3 := triple last.
  269.     Array
  270.         with: (square1 //3)@(square1 \\3) +1
  271.         with: (square2 //3)@(square2 \\3) +1
  272.         with: (square3 //3)@(square3 \\3) +1].
  273. "instance initialization"
  274. board := (Array new: 9) atAllPut: #Empty; yourself.
  275. winner := nil.
  276. lastPlayer := #NoOne.!
  277.  
  278. isLegalFor: aPlayer toPlayAt: aCoordinate
  279. (aCoordinate x between: 1 and: 3) &
  280.  (aCoordinate y between: 1 and: 3) ifFalse: [^false].
  281. (self at: aCoordinate) == #Empty ifFalse: [^false].
  282. (self winner == #NoOne) ifFalse: [^false].
  283. ^lastPlayer ~= aPlayer!
  284.  
  285. nextPlayer
  286. ^lastPlayer == #X ifTrue: [#O]
  287.                   ifFalse: [#X]!
  288.  
  289. nextPlayer: aPlayer
  290. (lastPlayer == #NoOne)&((aPlayer == #X)|(aPlayer == #O))
  291.     ifFalse: [self error: 'initialize with X or O'].
  292. lastPlayer := aPlayer == #X
  293.     ifTrue: [#O]
  294.     ifFalse: [#X].
  295. ^aPlayer!
  296.  
  297. play: aPlayer at: aCoordinate
  298. (self isLegalFor: aPlayer toPlayAt: aCoordinate)
  299.     ifTrue: [self at: aCoordinate put: aPlayer]
  300.     ifFalse: [self error: 'You cannot play at', aCoordinate printString].
  301. lastPlayer := aPlayer!
  302.  
  303. winner
  304. "Returns X, O or NoOne"
  305. | coordinate1 coordinate2 coordinate3
  306.   square1 square2 square3 |
  307. winner ~~ nil ifTrue: [^winner].
  308. "consider each possible line"
  309. winningLines do: [:triple |
  310.     coordinate1 := triple first.
  311.     coordinate2 := triple at: 2.
  312.     coordinate3 := triple last.
  313.     square1 := self at: coordinate1.
  314.     square2 := self at: coordinate2.
  315.     square3 := self at: coordinate3.
  316.     (square1 ~~ #Empty)&(square1 == square2)&(square2==square3)
  317.         ifTrue: [
  318.             winner := square1.
  319.             winningLine := Array
  320.                 with: coordinate1
  321.                 with: coordinate2
  322.                 with: coordinate3.
  323.             ^winner]].
  324. "there is no winner"
  325. ^#NoOne!
  326.  
  327. winningLine
  328. ^winningLine! !
  329.  
  330.  
  331. !InteractiveTicTacToe class methods !
  332.  
  333. example1
  334. " InteractiveTicTacToe example1 "
  335. self new open! !
  336.  
  337.  
  338. !InteractiveTicTacToe methods !
  339.  
  340. drawTile: aTile
  341. "Draw a specified tile"
  342. | aCoordinate scaledRectangle tileType aPen xBranchSize |
  343. aCoordinate := tiles at: aTile.
  344. scaledRectangle := (gameRectangle scaleTo: aTile)
  345.                                  insetBy: 3@3.
  346. tileType:= self at: aCoordinate.
  347. (aPen := Pen new)
  348.     defaultNib: 4@4;
  349.     place: scaledRectangle center truncated.
  350. xBranchSize := (scaledRectangle width min:
  351.                 scaledRectangle height) // 2.
  352. Display white: scaledRectangle.
  353. tileType == #X ifTrue:[
  354.         aPen turn: 45.
  355.         4 timesRepeat: [
  356.             aPen go: xBranchSize;
  357.                 go: xBranchSize negated;
  358.                 turn: 90]].
  359. tileType == #O ifTrue: [
  360.         aPen ellipse: xBranchSize * 3 // 4
  361.              aspect: 1]!
  362.  
  363. drawWinnerLine
  364. "draw a line from center of outermost tiles of
  365. winning squares"
  366. | firstTile lastTile |
  367. firstTile := tiles keyAtValue: self winningLine first.
  368. lastTile := tiles keyAtValue: self winningLine last.
  369. Pen new
  370.     defaultNib: 5@5;
  371.     place: (gameRectangle scaleTo: firstTile) center;
  372.     goto: (gameRectangle scaleTo: lastTile) center.!
  373.  
  374. initialize
  375. "Set up new game"
  376. super initialize.
  377. "Set up tiles"
  378. tiles := Dictionary new.
  379. 1 to: 3 do: [:row |
  380.     1 to: 3 do: [:column |
  381.         tiles
  382.             at: (((column - 1)/3)@((row - 1)/3)
  383.             extent: (1/3)@(1/3))
  384.             put: row@column]].!
  385.  
  386. label
  387. "Answer the label for the game window"
  388. | theWinner |
  389. self gameOver ifFalse:[^'Player',self nextPlayer,'''s move'].
  390. theWinner := self winner.
  391. theWinner == #NoOne ifTrue:[^'Nobody one'].
  392. theWinner == #X ifTrue:[^'X won!!'].
  393. theWinner == #O ifTrue:[^'O won!!'].
  394. ^'TicTacToe'.!
  395.  
  396. menu
  397. "Answer the menu for the TilePane"
  398. ^Menu labels: 'restart'
  399.       lines: #()
  400.       selectors: #restart!
  401.  
  402. mouseEnteringTile: aTile
  403. "Reverse the tile"
  404. | scaledRectangle |
  405. scaledRectangle := (gameRectangle scaleTo: aTile)
  406.                                   insetBy: 3@3.
  407. Display gray: scaledRectangle!
  408.  
  409. mouseExitingTile: aTile
  410. "reverse the Tile"
  411. self mouseEnteringTile: aTile.!
  412.  
  413. mouseSelectingTile: aTile
  414. " update the game and pane with selected tile"
  415. | aCoordinate row column |
  416. self gameOver ifTrue: [^self].
  417. aCoordinate := tiles at: aTile.
  418. (self isLegalFor: self nextPlayer toPlayAt: aCoordinate)
  419.     ifTrue: [self play: self nextPlayer at: aCoordinate]
  420.     ifFalse: [6 timesRepeat: [Display reverse.
  421.                     5000 timesRepeat:[]].
  422.                     ^self].
  423. (self gameOver and: [self winner ~~ #NoOne])
  424.     ifTrue: [self changed: #tiles:]
  425.     ifFalse: [self drawTile: aTile].
  426. self changed: #label!
  427.  
  428. open
  429. "Start up new game"
  430. | topPane |
  431. topPane := TopPane new
  432. label: self label;
  433. model: self;
  434. addSubpane: (TilePane new
  435.     model: self;
  436.     name: #tiles:;
  437.     onMouseEnteringTile: #mouseEnteredTile:;
  438.     onMouseExitingTile: #mouseExitingTile:;
  439.     onMouseSelectingTile: #mouseSelectingTile:;
  440.     menu: #menu;
  441.     yourself);
  442. yourself.
  443. topPane dispatcher open scheduleWindow.!
  444.  
  445. restart
  446. "Restart the game"
  447. self initialize.
  448. self changed: #tiles:; changed: #label!
  449.  
  450. tiles: aRectangle
  451. "Draw the background on the tiling plane framed
  452. at aRectangle and answer a collection of relative
  453. rectangles for the tiles"
  454. | beginningTile endingTile |
  455. gameRectangle := aRectangle.
  456. Display gray:gameRectangle.
  457. tiles keysDo: [:aTile | self drawTile: aTile].
  458. self winner == #NoOne ifFalse:
  459.         [self drawWinnerLine].
  460. ^tiles keys.! !
  461.  
  462. "construct application" 
  463. ((Smalltalk at: #Application ifAbsent: []) 
  464.     isKindOf: Class) ifTrue: [ 
  465.         ((Smalltalk at: #Application) for:'TicTacToe')
  466.             addClass: TileDispatcher;
  467.             addClass: TilePane;
  468.             addClass: TicTacToeGame;
  469.             addClass: InteractiveTicTacToe;
  470.             comments: '"Interactive TicTacToe game
  471. based on W. LaLonde & J. Pugh
  472. J.O.O.P Sept/Oct 1989 pp 57-66"
  473. ';
  474.             initCode: 'InteractiveTioTacToe example1
  475. ';
  476.             finalizeCode: nil;
  477.             startUpCode: 'InteractiveTicTacToe example1
  478. ']!
  479.